home *** CD-ROM | disk | FTP | other *** search
/ Sun Solutions 1997 April to September / Sun Solutions CD - APR '97 - SEP '97 (704-3778-12 Rev. H)(Sun Microsystems, Inc.)(1997).iso / products / bin / httpd / Solaris_2 / newwais.pl.bk < prev    next >
Text File  |  1995-10-20  |  4KB  |  155 lines
  1. #!./perl
  2. #
  3. # newwais.pl -- WAIS search interface
  4. #
  5. # from wais.pl
  6. #
  7. # Tony Sanders <sanders@bsdi.com>, Nov 1993
  8. #
  9. # Example configuration (in local.conf):
  10. #     map topdir wais.pl &do_wais($top, $path, $query, "database", "title")
  11. #
  12. # this script uses a sneaky feature of Mosaic that interpretes a 
  13. # single text input form with the name 'isindex' (case sensitive) to
  14. # the same as a <ISINDEX>.  On non-mosaic clients, you wind up with an
  15. # additional query
  16. #
  17. # Note that I know even less about perl than the other two people
  18. # who hacked this, so feel free to send hate mail to pjh@netcom.com
  19. # if I did something really bad (or if there is a better way of
  20. # grabbing the filename off the end of a path.
  21. #
  22.  
  23. #require 'ctime.pl';
  24.  
  25. $waisq = "./waisq";
  26. $waisd = "/tmp/.wais/wais";
  27.  
  28.  
  29. $src = "catalyst_catalog";
  30. $title = "Example Data";
  31. #
  32. # file type map based on file extension, since all file types
  33. # come back type URL
  34. #
  35.  
  36. %filetype = (
  37. 'html', 'HTML File',
  38. );
  39.  
  40. #
  41. # code
  42. # 
  43.  
  44. sub send_index {
  45.     print "Content-type: text/html\n\n";
  46.     
  47.     print "<HEAD>\n<TITLE>Index of ", $title, "</TITLE>\n</HEAD>\n";
  48.     print "<BODY>\n<H1>", $title, "</H1>\n";
  49.  
  50.     print "This is an index of the information on this server. Please\n";
  51.     print "type a query in the search dialog.\n<P>";
  52.     print "You may use compound searches, such as: <CODE>environment AND cgi</CODE>\n";
  53.     print "<ISINDEX>";
  54. }
  55.  
  56. sub do_wais {
  57. #    local($top, $path, $query, $src, $title) = @_;
  58.  
  59. # strip the escape off of *'s
  60.     for (@ARGV){s/\\//g};
  61.  
  62.     do { &'send_index; return; } unless defined @ARGV;
  63.     local(@query) = @ARGV;
  64.     local($pquery) = join(" ", @query);
  65.     local($nquery) = $pquery;
  66.     $nquery =~ tr/[A-Z]/[a-z]/;
  67.     if (!(($nquery =~ / and /) || ($nquery =~ / or /)))
  68.     {
  69.        $nquery =~ s/ //g;
  70.     }
  71. #
  72. # grab a wais source if there is one
  73. #
  74.  
  75.     local($test) = $ENV{'PATH_INFO'};
  76.     if ($test)
  77.     {
  78.     $test =~ s/\///;
  79.         $src = "catalyst_catalog";
  80.         $title = $test;
  81.     }
  82.  
  83.     close STDERR;
  84.     open(STDERR, ">/dev/null");
  85.  
  86.     print "Content-type: text/html\n\n";
  87.  
  88.     $ENV{'HOME'} = "/";
  89.     
  90.     open(WAISQ, "-|") || exec ($waisq, "-c", $waisd, "-m", 200,
  91.                                 "-f", "-", "-S", "$src.src", "-g", $nquery);
  92.  
  93.     print "<HEAD>\n<TITLE>Search of ", $title, "</TITLE>\n</HEAD>\n";
  94.     print "<img src=\"/.wais/images/goto_home.gif\">\n";
  95.     print "<BODY>\n<H1>Catalyst Catalog on CDware</H1>\n";
  96.  
  97.     print "<HR><FORM method=\"POST\" action=\"/cgi-bin/newwais.pl/$src\">\n";
  98.     print "Enter keyword(s):\n";
  99. #    print "<input name=\"isindex\" value=\"@query\" size=30></FORM><HR>\n";
  100.     print "<input name=\"isindex\" value=\"$pquery\" size=30></FORM><HR>\n";
  101.  
  102.     print "$title contains the following\n";
  103.     print "items relevant to <B>\`$pquery\':</B><P>\n";
  104.     print "<DL>\n";
  105.  
  106.     local($hits, $score, $headline, $lines, $bytes, $type, $date);
  107.  
  108.     print "<OL>";
  109.     while (<WAISQ>) {
  110.         /:score\s+(\d+)/ && ($score = $1);
  111.         /:number-of-lines\s+(\d+)/ && ($lines = $1);
  112.         /:number-of-bytes\s+(\d+)/ && ($bytes = $1);
  113.         /:type "(.*)"/ && ($type = $1);
  114.         /:headline "(.*)"/ && ($headline = $1);         # XXX
  115.         /:date "(\d+)"/ && ($date = $1, $hits++, &docdone);
  116.     }
  117.     print "</OL>";
  118.     close(WAISQ);
  119.     print "</DL>\n";
  120.  
  121.     if ($hits == 0) {
  122.         print "Nothing found.\n";
  123.     }
  124.     print "</BODY>\n";
  125. }
  126.  
  127.  
  128. sub docdone {
  129.  
  130.     if ($headline =~ /Search produced no result/) {
  131.         print "<HR>";
  132.     print "Search produced no result.";
  133. #        print $headline, "<P>\n<PRE>";
  134. # the following was &'safeopen
  135. #        open(WAISCAT, "$waisd/$src.cat") || die "$src.cat: $!";
  136. #        while (<WAISCAT>) {
  137. #            s#(Catalog for database:)\s+.*#$1 <STRONG>Catalyst Catalog on CDware</STRONG>#;
  138. #            s#Headline:\s+(.*)#Headline: <A HREF="$1">$1</A>#;
  139. #            print;
  140. #        }
  141. #        close(WAISCAT);
  142. #        print "\n</PRE>\n";
  143.     } else {
  144.         $docname = $headline;
  145.     $docname =~ s/\.([^.]*)$//;
  146.     $extension= $1;
  147.     $docname =~ s/\/([^\/]*)$//;
  148.     $docname = $1;
  149.         print "<LI><A HREF=\"$headline\"><B>$docname</B></A>\n";
  150.     }
  151.     $score = $headline = $lines = $bytes = $type = $date = '';
  152. }
  153.  
  154. eval '&do_wais';
  155.